home *** CD-ROM | disk | FTP | other *** search
/ The Programmer Disk / The Programmer Disk (Microforum).iso / xpro / qb2 / pro20 / qdir.bas < prev    next >
Encoding:
BASIC Source File  |  1989-04-21  |  11.0 KB  |  374 lines
  1. DEFINT A-Z
  2.  
  3. '------------------------------- Define Types ---------------------------
  4.  
  5. TYPE RegType                'Type statement for CALL INTERRUPT
  6.      ax    AS INTEGER       'ax register
  7.      bx    AS INTEGER       'bx register
  8.      cx    AS INTEGER       'cx register
  9.      dx    AS INTEGER       'dx register
  10.      bp    AS INTEGER
  11.      si    AS INTEGER
  12.      di    AS INTEGER
  13.      flags AS INTEGER
  14.      ds    AS INTEGER
  15.      es    AS INTEGER
  16. END TYPE
  17.  
  18. '--------------------------- Declare Procedures -------------------------
  19.  
  20. DECLARE FUNCTION GetPath$ (Drive$)
  21. DECLARE FUNCTION GetDrive$ ()
  22. DECLARE FUNCTION ParseCommandLine$ ()
  23. DECLARE SUB DIR (Path$, DirArray() AS STRING, FA%)
  24. DECLARE SUB DisplayFiles ()
  25. DECLARE SUB DisplayFreeSpace ()
  26. DECLARE SUB DisplayVolume ()
  27. DECLARE SUB GetFiles ()
  28. DECLARE SUB Initialize ()
  29. DECLARE SUB INTERRUPT (IntNo%, InReg AS RegType, OutReg AS RegType)
  30. DECLARE SUB InterruptX (IntNo%, InReg AS RegType, OutReg AS RegType)
  31. DECLARE SUB KillWindow (XStart%, YStart%, DeltaX%, DeltaY%, WindowMemory$)
  32. DECLARE SUB MakeWindow (XStart%, YStart%, DeltaX%, DeltaY%, ForegroundColor%, BackgroundColor%, Border%, WindowMemory$)
  33. DECLARE SUB PopOff ()
  34. DECLARE SUB Popup ()
  35. DECLARE SUB ScrollUp (AL%, BH%, CH%, CL%, DH%, DL%)
  36. DECLARE SUB ScrollDown (AL%, BH%, CH%, CL%, DH%, DL%)
  37. DECLARE SUB WindowControl ()
  38.  
  39. '------------------------------ Dimensions-------------------------------
  40.  
  41. DIM Info(256) AS STRING
  42. DIM regs AS RegType, sb AS STRING * 64
  43.  
  44. '- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  45.  
  46. COMMON SHARED Info() AS STRING, WinBuff AS STRING * 4000, OldY, MaxInfo, Total
  47. COMMON SHARED Drive AS STRING, Path AS STRING
  48. COMMON SHARED b, f, x, y, dx, dy
  49. COMMON SHARED Top, Bottom
  50.  
  51. '************************************************************************
  52. '**                         Main Program                               **
  53. '************************************************************************
  54.  
  55.    Initialize
  56.    Popup
  57.    DisplayVolume
  58.    DisplayFreeSpace
  59.    GetFiles
  60.    DisplayFiles
  61.    WindowControl
  62.    PopOff
  63.  
  64. END
  65.  
  66. '************************************************************************
  67. '************************************************************************
  68.  
  69. SUB DisplayFiles
  70. '------------------------------------------------------------------------
  71. '  procedure DisplayFiles displays the first part of the list of files
  72. '  in the window.
  73. '------------------------------------------------------------------------
  74.  
  75.    LOCATE y + (dy - 4), x + 2
  76.    IF MaxInfo > 0 THEN
  77.       LOCATE y + 2, x + (dx - 13)
  78.       PRINT USING "###"; MaxInfo; :
  79.       PRINT " File(s)";
  80.       SWAP f, b
  81.       COLOR b, f
  82.       ScrollUp 0, 112, y + 4, x + 1, y + (dy - 5), x + (dx - 2)
  83.       FOR u = Top TO Bottom
  84.          LOCATE y + u + 3, x + 3
  85.          PRINT Info(u);
  86.       NEXT u
  87.       ELSE
  88.       LOCATE y + 8, x + (dx - 34)
  89.       PRINT "File Not Found."
  90.       SWAP b, f
  91.    END IF
  92.  
  93. END SUB
  94.  
  95. SUB DisplayFreeSpace
  96. '------------------------------------------------------------------------
  97. '  procedure DisplayFreeSpace calculates the free disk space on the
  98. '  specified drive and displays it in the window.
  99. '------------------------------------------------------------------------
  100.  
  101.    DIM regs AS RegType
  102.  
  103.    regs.ax = &H3600
  104.    regs.dx = ASC(Drive$) - 64
  105.    INTERRUPT &H21, regs, regs
  106.    BytesAvail& = regs.ax * regs.cx
  107.    BytesAvail& = regs.bx * BytesAvail&
  108.    LOCATE y + dy - 3, x + 2
  109.    PRINT USING "#########"; BytesAvail&; :
  110.    PRINT " bytes available on drive "; Drive$; ":"
  111.  
  112. END SUB
  113.  
  114. SUB DisplayVolume
  115. '------------------------------------------------------------------------
  116. '  procedure DisplayVolume gets the volume name from the specified drive
  117. '  and displays it.
  118. '------------------------------------------------------------------------
  119.  
  120.    DIR Drive$ + ":\*.*", Info(), &H8
  121.  
  122.    LOCATE y + 2, x + 1
  123.    PRINT " Volume Name: ";
  124.    IF INSTR(LEFT$(Info(1), 12), " ") > 1 THEN
  125.       PRINT LEFT$(Info(1), 12)
  126.    ELSE
  127.       PRINT "<Unlabeled>";
  128.    END IF
  129.  
  130. END SUB
  131.  
  132. SUB GetFiles
  133. '------------------------------------------------------------------------
  134. '  procedure GetFiles gets the files matching the current search string
  135. '  into the array Info().
  136. '------------------------------------------------------------------------
  137.  
  138.    Total = 0
  139.  
  140.    DIR Path$, Info(), &H10
  141.  
  142.    StopFlag = 0
  143.    WHILE INSTR(Info(Total + 1), " ") > 1 AND StopFlag < 2
  144.       Total = Total + 1
  145.       IF INSTR(Info(Total), " ") > 1 THEN
  146.       ELSE
  147.          Total = Total - 1
  148.          StopFlag = StopFlag + 1
  149.       END IF
  150.    WEND
  151.   
  152.    MaxInfo = Total
  153.    IF MaxInfo <= dy - 8 THEN
  154.       Bottom = MaxInfo
  155.    ELSE
  156.       Bottom = dy - 8
  157.    END IF
  158.  
  159. END SUB
  160.  
  161. SUB Initialize
  162. '------------------------------------------------------------------------
  163. '  procedure Initialize sets up default variables.
  164. '------------------------------------------------------------------------
  165.  
  166.    b = 7
  167.    f = 0
  168.    x = 16
  169.    y = 3
  170.    dx = 49
  171.    dy = 20
  172.   
  173.    Path$ = ParseCommandLine$
  174.    OldY = CSRLIN - 1
  175.    IF OldY = 0 THEN OldY = 1
  176.  
  177.    LOCATE , , 0
  178.  
  179. END SUB
  180.  
  181. FUNCTION ParseCommandLine$
  182. '------------------------------------------------------------------------
  183. '  procedure ParseCommandLine returns a search string using the command
  184. '  line arguments passed from DOS.  If no command line arguments were
  185. '  passed, it builds a path from the default DOS drive and path.
  186. '------------------------------------------------------------------------
  187.  
  188.    ParsePath$ = COMMAND$
  189.    FileSpec$ = "*.*"
  190.    IF RIGHT$(ParsePath$, 2) = ".." THEN ParsePath$ = ParsePath$ + "\*.*"
  191.    IF RIGHT$(ParsePath$, 1) = "." AND LEN(ParsePath$) = 1 THEN ParsePath$ = ""
  192.    IF RIGHT$(ParsePath$, 1) = "." AND (LEFT$(RIGHT$(ParsePath$, 2), 1) = ":" OR LEFT$(RIGHT$(ParsePath$, 2), 1) = "\") THEN ParsePath$ = LEFT$(ParsePath$, LEN(ParsePath$) - 1) + "*.*"
  193.  
  194.    IF ParsePath$ = "" THEN
  195.       Drive$ = GetDrive$
  196.       ParsePath$ = Drive$ + ":\" + GetPath$(Drive$)
  197.       IF p$ = "" THEN FileSpec$ = "*.*"
  198.       ELSEIF LEN(ParsePath$) = 3 AND INSTR(ParsePath$, ":") = 2 THEN
  199.       ParsePath$ = ParsePath$
  200.       Drive$ = LEFT$(ParsePath$, 1)
  201.    ELSEIF LEN(ParsePath$) = 2 AND RIGHT$(ParsePath$, 1) = ":" THEN
  202.       Drive$ = LEFT$(ParsePath$, 1)
  203.       ParsePath$ = Drive$ + ":\" + GetPath$(Drive$)
  204.       IF GetPath$(Drive$) = "" THEN FileSpec$ = "*.*"
  205.    ELSE
  206.       IF INSTR(ParsePath$, ":") <> 2 THEN
  207.          Drive$ = GetDrive$
  208.       ELSE
  209.       Drive$ = LEFT$(ParsePath$, 1)
  210.       ParsePath$ = RIGHT$(ParsePath$, LEN(ParsePath$) - 2)
  211.       END IF
  212.       IF LEFT$(ParsePath$, 1) = "\" THEN
  213.          ParsePath$ = Drive$ + ":" + ParsePath$
  214.       ELSE
  215.  
  216.          IF GetPath$(Drive$) = "" THEN FileSpec$ = "*.*"
  217.          IF GetPath$(Drive$) = "" THEN
  218.             ParsePath$ = Drive$ + ":" + GetPath$(Drive$) + "\" + ParsePath$
  219.          ELSE
  220.             ParsePath$ = Drive$ + ":\" + GetPath$(Drive$) + "\" + ParsePath$
  221.          END IF
  222.       END IF
  223.       IF INSTR(ParsePath$, ".") > 0 THEN
  224.          FileSpec$ = ""
  225.          FOR s = LEN(ParsePath$) TO 1 STEP -1
  226.             IF MID$(ParsePath$, s, 1) = "\" THEN EXIT FOR ELSE FileSpec$ = MID$(ParsePath$, s, 1) + FileSpec$
  227.          NEXT s
  228.          ParsePath$ = LEFT$(ParsePath$, s)
  229.       END IF
  230.    END IF
  231.  
  232.    IF RIGHT$(ParsePath$, 1) <> "\" AND LEFT$(FileSpec$, 1) <> "\" THEN FileSpec$ = "\" + FileSpec$
  233.    ParseCommandLine$ = ParsePath$ + FileSpec$
  234.  
  235. END FUNCTION
  236.  
  237. SUB PopOff
  238. '------------------------------------------------------------------------
  239. '  procedure PopOff restores the screen and re-locates the cursor where
  240. '  it was upon entry to the program.
  241. '------------------------------------------------------------------------
  242.  
  243. KillWindow x, y, dx, dy, WinBuff$
  244. LOCATE OldY, 1, 1
  245.  
  246. END SUB
  247.  
  248. SUB Popup
  249. '------------------------------------------------------------------------
  250. '  procedure DoWindow puts a window on the screen and details it after
  251. '  saving the contents of the screen behind it.
  252. '------------------------------------------------------------------------
  253.  
  254.    WinText$ = "[ Directory of " + Path$ + " ]"
  255.  
  256.  
  257.    MakeWindow x, y, dx, dy, b, f, 2, WinBuff$
  258.    LOCATE y, x + (dx - (LEN(WinText$))) \ 2
  259.    COLOR f, b
  260.    PRINT WinText$
  261.    COLOR b, f
  262.  
  263.    Top = 1
  264.    COLOR b, f
  265.    LOCATE y + 1, x + (dx - 15)
  266.    PRINT "│"
  267.    LOCATE y + 2, x + (dx - 15)
  268.    PRINT "│"
  269.    LOCATE y + 3, x + 1
  270.    PRINT STRING$(dx - 16, "─");
  271.    PRINT "┴";
  272.    PRINT STRING$(13, "─");
  273.    LOCATE y + dy - 4, x + 1
  274.    PRINT STRING$(dx - 10, "─");
  275.    PRINT "┬───────";
  276.    LOCATE y + dy - 3, x + (dx - 9)
  277.    PRINT "│"
  278.    LOCATE y + dy - 2, x + (dx - 9)
  279.    PRINT "│"
  280.  
  281. END SUB
  282.  
  283. SUB WindowControl
  284. '------------------------------------------------------------------------
  285. '  procedure WindowControl manages the files in the window and updates
  286. '  the window.
  287. '------------------------------------------------------------------------
  288.  
  289.    WHILE Key$ <> CHR$(27)
  290.       Key$ = UCASE$(INKEY$)
  291.       IF Total = 0 THEN
  292.          COLOR f, b
  293.          LOCATE y + dy - 3, x + dx - 3
  294.          PRINT CHR$(25);
  295.          LOCATE y + dy - 3, x + dx - 4
  296.          PRINT CHR$(24);
  297.          COLOR b, f
  298.          END IF
  299.          IF Bottom > MaxInfo AND Total > 0 THEN
  300.          COLOR f, b
  301.          LOCATE y + dy - 3, x + dx - 3
  302.          PRINT CHR$(25);
  303.          COLOR 15, 0
  304.          LOCATE y + dy - 3, x + dx - 4
  305.          PRINT CHR$(24);
  306.          COLOR b, f
  307.       ELSEIF Top = 1 AND Total > 0 THEN
  308.          COLOR 15, 0
  309.          LOCATE y + dy - 3, x + dx - 3
  310.          PRINT CHR$(25);
  311.          COLOR f, b
  312.          LOCATE y + dy - 3, x + dx - 4
  313.          PRINT CHR$(24);
  314.          COLOR b, f
  315.       ELSE
  316.          IF Total > 0 THEN
  317.             LOCATE y + dy - 3, x + dx - 4
  318.             COLOR 15, 0
  319.             PRINT CHR$(24); CHR$(25)
  320.             COLOR b, f
  321.          END IF
  322.       END IF
  323.      
  324.       DEF SEG = 0
  325.      
  326.       LOCATE y + dy - 1, x + dx - 11
  327.      
  328.       IF PEEK(&H417) AND 64 THEN
  329.          PRINT "CAP";
  330.       ELSE
  331.          PRINT "═══";
  332.       END IF
  333.      
  334.       LOCATE y + dy - 1, x + dx - 16
  335.      
  336.       IF PEEK(&H417) AND 32 THEN
  337.          PRINT "NUM";
  338.       ELSE
  339.          PRINT "═══";
  340.       END IF
  341.      
  342.       LOCATE y + dy - 1, x + dx - 6
  343.      
  344.       IF PEEK(&H417) AND 16 THEN
  345.          PRINT "SCR";
  346.       ELSE
  347.          PRINT "═══";
  348.       END IF
  349.      
  350.       DEF SEG
  351.      
  352.       IF LEN(Key$) > 1 THEN
  353.         
  354.          IF ASC(RIGHT$(Key$, 1)) = 72 AND Top > 1 THEN
  355.             ScrollDown 1, 112, y + 4, x + 3, y + (dy - 5), x + (dx - 4)
  356.             Bottom = Bottom - 1
  357.             Top = Top - 1
  358.             LOCATE y + 4, x + 3
  359.             PRINT Info(Top);
  360.          END IF
  361.         
  362.          IF ASC(RIGHT$(Key$, 1)) = 80 AND Bottom < MaxInfo AND MaxInfo > (dy - y) - 5 THEN
  363.             ScrollUp 1, 112, y + 4, x + 3, y + (dy - 5), x + (dx - 4)
  364.             Top = Top + 1
  365.             Bottom = Bottom + 1
  366.             LOCATE y + (dy - 5), x + 3
  367.             PRINT Info(Bottom);
  368.          END IF
  369.       END IF
  370.    WEND
  371.  
  372. END SUB
  373.  
  374.